MacFormat 1995 April/macformat-023.iso/Shareware City/Developers/ICProgKit1.0/Source/RandomSignature/ICRandomSignature.p

Text File | 1994-11-27 | 13.2 KB | 498 lines | [TEXT/PJMM]

unit ICRandomSignature;

interface

    uses
        Components;

    function Main (var params: ComponentParameters; storage: Handle): ComponentResult;

implementation

    uses
{$ifc undefined THINK_Pascal}
        Types, Files, QuickDraw, Aliases, Packages, Memory, Errors, ToolUtils, Resources,

        ICTypes,
{$endc}
        Folders, ICCAPI, ICKeys;

    const
        kOurComponentManufacturer = 'JMJ ';

    function DecStr (l: longint): Str32;
        var
            tmpstr: Str255;
    begin
        NumToString(l, tmpstr);
        DecStr := tmpstr;
    end; (* DecStr *)

    const
        kICCStart = 0;
        kICCStop = 1;
        kICCFindConfigFile = 2;
        kICCSpecifyConfigFile = 3;
        kICCGetSeed = 4;
        kICCBegin = 5;
        kICCGetPref = 6;
        kICCSetPref = 7;
        kICCCountPref = 8;
        kICCGetIndPref = 9;
        kICCEnd = 10;
        kICCDefaultFile = 11;
        kICCDeletePref = 12;
        kICCGetPerm = 13;

        kICC_first_select = kICCStart;
        kICC_last_select = kICCGetPerm;

    type
        globalsRecord = record
                self: ComponentInstance;
                target: ComponentInstance;
                delegate: ComponentInstance;

                current_signature: Handle;
                default_signature: Handle;
                sig_folder_name: Str63;
            end;
        globalsPtr = ^globalsRecord;
        globalsHandle = ^globalsPtr;

        sharedGlobals = record
                delegate: Component;
            end;
        sharedGlobalsPtr = ^sharedGlobals;

    function GetSharedGlobals (globals: globalsHandle): sharedGlobalsPtr;
        var
            shared: sharedGlobalsPtr;
    begin
        shared := nil;
        if GetComponentInstanceA5(globals^^.self) = 0 then begin
            shared := sharedGlobalsPtr(GetComponentRefcon(Component(globals^^.self)));
        end
        else begin
(* Debugger; *)
(* This, needless to say, is not the correct answer.  You're support to go madly search for the component. *)
(* I just can't be bothered to deal with this at the moment. *)
        end; (* if *)
        GetSharedGlobals := shared;
    end; (* GetSharedGlobals *)

(* Component Manager routines *)

    function RSCRegister (globals: globalsHandle): ComponentResult;
        var
            shared: sharedGlobalsPtr;
            err: OSErr;
            junk: OSErr;
    begin
        junk := SetDefaultComponent(Component(globals^^.self), defaultComponentIdentical + defaultComponentAnyFlags);
        shared := sharedGlobalsPtr(NewPtrSysClear(sizeof(sharedGlobals)));
        err := MemError;
        if err = noErr then begin
            shared^.delegate := nil;
            SetComponentRefcon(Component(globals^^.self), longint(shared));
        end; (* if *)
        RSCRegister := err;
    end; (* RSCRegister *)

    function RSCUnregister (globals: globalsHandle): ComponentResult;
        var
            shared: sharedGlobalsPtr;
            result: ComponentResult;
    begin
        result := -1;
        shared := GetSharedGlobals(globals);
        if shared <> nil then begin
            result := UncaptureComponent(shared^.delegate);
            DisposePtr(Ptr(shared));
        end; (* if *)
        RSCUnregister := result;
    end; (* RSCUnregister *)

    function RSCCanDo (globals: globalsHandle; selector: integer): ComponentResult;
    (* Handle the Component Manager CanDo request.*)
    begin
        case selector of
            kComponentUnregisterSelect..kComponentOpenSelect:
                RSCCanDo := 1;
            otherwise
                RSCCanDo := ComponentFunctionImplemented(globals^^.delegate, selector);
        end; (* case *)
    end; (* RSCCanDo *)

    function FindDelegate (after: Component): Component;
        var
            cd: ComponentDescription;
            found_cd: ComponentDescription;
            current: Component;
            found: boolean;
    begin
        cd.componentType := internetConfigurationComponentType;
        cd.componentSubType := internetConfigurationComponentSubType;
        cd.componentManufacturer := OSType(0);
        cd.componentFlags := 0;
        cd.componentFlagsMask := 0;
        current := after;
        repeat
            (* DebugStr(concat('in loop for ', kOurComponentManufacturer)); *)
            current := FindNextComponent(current, cd);
            if current <> nil then begin
                if GetComponentInfo(current, found_cd, nil, nil, nil) = noErr then begin
                    found := (found_cd.componentManufacturer <> kOurComponentManufacturer);
                end; (* if *)
            end; (* if *)
        until found or (current = nil);
        FindDelegate := current;
    end; (* FindDelegate *)

    function InitGlobals (globals: globalsHandle): ComponentResult;
        var
            err: ComponentResult;
            refnum: integer;
            strh: StringHandle;
            junk: OSErr;
    begin
        err := noErr;
        refnum := OpenComponentResFile(Component(globals^^.self));
        if refnum <= 0 then begin
            err := resNotFound;
        end; (* if *)
        if err = noErr then begin
            strh := GetString(130);
            if strh = nil then begin
                err := resNotFound;
            end
            else begin
                globals^^.sig_folder_name := strh^^;
            end; (* if *)
            if err = noErr then begin
                globals^^.default_signature := Get1Resource('TEXT', 128);
                if globals^^.default_signature = nil then begin
                    err := resNotFound;
                end
                else begin
                    DetachResource(globals^^.default_signature);
                end; (* if *)
                globals^^.current_signature := nil;
            end; (* if *)
            junk := CloseComponentResFile(refnum);
        end; (* if *)
        InitGlobals := err;
    end; (* InitGlobals *)

    function RSCOpen (globals: globalsHandle; self: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Open request, mostly delayed until ICCStart. *)
        var
            err: ComponentResult;
            cap: Component;
            shared: sharedGlobalsPtr;
            tmp: Component;
    begin
        (* create our globals *)
        globals := globalsHandle(NewHandleClear(sizeof(globalsRecord)));
        err := MemError;
        if err = noErr then begin
            HLock(Handle(globals));
(* Debugger; *)
            globals^^.self := self;
            SetComponentInstanceStorage(self, Handle(globals));
            shared := GetSharedGlobals(globals);
            if shared <> nil then begin
                if shared^.delegate = nil then begin
                    tmp := FindDelegate(Component(self));
                    if tmp <> nil then begin
                        shared^.delegate := CaptureComponent(tmp, Component(self));
                    end; (* if *)
                end; (* if *)
                globals^^.delegate := OpenComponent(shared^.delegate);
                err := ComponentSetTarget(self, self);
            end; (* if *)
            if err = noErr then begin
                err := InitGlobals(globals);
            end; (* if *)
            HUnlock(Handle(globals));
        end; (* if *)
        RSCOpen := err;
    end; (* RSCOpen *)

    function RSCClose (globals: globalsHandle; self: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Close request. *)
        var
            err: ComponentResult;
            junk: OSErr;
    begin
        err := noErr;
        if globals <> nil then begin
            if globals^^.delegate <> nil then begin
                junk := CloseComponent(globals^^.delegate)
            end; (* if *)
            DisposeHandle(Handle(globals));
        end; (* if *)
        RSCClose := err;
    end; (* RSCClose *)

    function RSCTarget (globals: globalsHandle; new_target: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Target. *)
        var
            err: ComponentResult;
    begin
        globals^^.target := new_target;
        if globals^^.delegate <> nil then begin
            err := ComponentSetTarget(globals^^.delegate, new_target);
        end
        else begin
            err := noErr;
        end; (* if *)
        RSCTarget := err;
    end; (* RSCTarget *)

(* Internet Configuration specific routines *)

    function GetRandomSignature (globals: globalsHandle): Handle;
        var
            cpb: CInfoPBRec;
            sig: FSSpec;

        function GetNthTextFile (max_count: integer; var count: integer): OSErr;
            var
                err: OSErr;
                index: integer;
        begin
            count := 0;
            index := 1;
            repeat
                cpb.ioNamePtr := @sig.name;
                cpb.ioDirID := sig.parID;
                cpb.ioVRefNum := sig.vRefNum;
                cpb.ioFDirIndex := index;
                err := PBGetCatInfoSync(@cpb);
                index := index + 1;
                if (err = noErr) and not btst(cpb.ioFlAttrib, 4) and (cpb.ioFlFndrInfo.fdType = 'TEXT') then begin
                    count := count + 1;
                end; (* if *)
            until (err <> noErr) or (count = max_count);
            GetNthTextFile := err;
        end; (* GetNthTextFile *)

        var
            junk: OSErr;
            texth: Handle;
            err: OSErr;
            ref: integer;
            count: integer;
            length: longint;
    begin
        texth := nil;
        sig.name := globals^^.sig_folder_name;
        err := FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, sig.vRefNum, sig.parID);
        if err = noErr then begin
            cpb.ioNamePtr := @sig.name;
            cpb.ioVRefNum := sig.vRefNum;
            cpb.ioDirID := sig.parID;
            cpb.ioFDirIndex := 0;
            err := PBGetCatInfoSync(@cpb);
        end; (* if *)
        if (err = noErr) and not btst(cpb.ioFlAttrib, 4) then begin
            err := dirNFErr;
        end; (* if *)
        if err = noErr then begin
            sig.parID := cpb.ioDirID;
            junk := GetNthTextFile(32767, count);
            if count = 0 then begin
                err := fnfErr;
            end
            else begin
                count := (abs(random) mod count) + 1;
                err := GetNthTextFile(count, junk);
            end; (* if *)
        end; (* if *)
        if err = noErr then begin
            err := HOpen(sig.vRefNum, sig.parID, sig.name, fsRdPerm, ref);
        end; (* if *)
        if err = noErr then begin
            err := GetEOF(ref, length);
            if err = noErr then begin
                if length > 4096 then begin
                    length := 4096;
                end; (* if *)
                texth := NewHandle(length);
                err := MemError;
            end; (* if *)
            if err = noErr then begin
                err := FSRead(ref, length, texth^);
            end; (* if *)
            junk := FSClose(ref);
        end; (* if *)
        if err <> noErr then begin
            DisposeHandle(texth);
            texth := nil;
        end; (* if *)
        if texth = nil then begin
            texth := globals^^.default_signature;
            err := HandToHand(texth);
            if err <> noErr then begin
                texth := nil;
            end; (* if *)
        end; (* if *)
        GetRandomSignature := texth;
    end; (* GetRandomSignature *)

    procedure ChooseRandomSignature (globals: globalsHandle);
    begin
        if globals^^.current_signature <> nil then begin
            DisposeHandle(globals^^.current_signature);
        end; (* if *)
        globals^^.current_signature := GetRandomSignature(globals);
    end; (* ChooseRandomSignature *)

    const
        delegateThisCallErr = 1;

    function RSCBegin (globals: globalsHandle; perm: ICPerm): ICError;
        var
            err: ICError;
    begin
        ChooseRandomSignature(globals);
        RSCBegin := delegateThisCallErr;
    end; (* RSCBegin *)

    function RSCGetPref (globals: globalsHandle; key: Str255; var attr: ICAttr; buf: Ptr; var size: longint): ICError;
        var
            tmpstr: Str255;
            perm: icPerm;
            max_size: longint;
            err: ICError;
    begin
        if IUEqualString(key, kICSignature) = 0 then begin
            if (ICCGetPerm(globals^^.delegate, perm) = noErr) & (perm = icNoPerm) then begin
                ChooseRandomSignature(globals);
            end; (* if *)

            max_size := size;
            if globals^^.current_signature = nil then begin
                size := 0;
            end
            else begin
                size := GetHandleSize(globals^^.current_signature);
            end; (* if *)

            err := noErr;
            if ((max_size < 0) and (buf <> nil)) then begin
                err := paramErr;
            end; (* if *)
            if (err = noErr) and (buf <> nil) then begin
                if size > max_size then begin
                    err := icTruncatedErr;
                end
                else begin
                    max_size := size;
                end; (* if *)
                if max_size <> 0 then begin
                    BlockMove(globals^^.current_signature^, buf, max_size);
                end; (* if *)
            end; (* if *)

            attr := ICattr_locked_mask + ICattr_volatile_mask;
            RSCGetPref := err;
        end
        else begin
            RSCGetPref := delegateThisCallErr;
        end; (* if *)
    end; (* RSCGetPref *)

    function RSCSetPref (globals: globalsHandle; key: Str255; var attr: ICAttr; buf: Ptr; var size: longint): ICError;
    begin
        if IUEqualString(key, kICSignature) = 0 then begin
            RSCSetPref := icPermErr;
        end
        else begin
            RSCSetPref := delegateThisCallErr;
        end; (* if *)
    end; (* RSCSetPref *)

    function WhatToStr (what: integer): Str32;
    begin
        case what of
            (* Component Manager stuff *)
            kComponentVersionSelect:
                WhatToStr := 'kComponentVersionSelect';
            kComponentCanDoSelect:
                WhatToStr := 'kComponentCanDoSelect';
            kComponentOpenSelect:
                WhatToStr := 'kComponentOpenSelect';
            kComponentCloseSelect:
                WhatToStr := 'kComponentCloseSelect';
            kComponentTargetSelect:
                WhatToStr := 'kComponentTargetSelect';
            kComponentRegisterSelect:
                WhatToStr := 'kComponentRegisterSelect';
            kComponentUnregisterSelect:
                WhatToStr := 'kComponentUnregisterSelect';
            (* this component type stuff *)
            kICCGetPref:
                WhatToStr := 'kICCGetPref';
            kICCSetPref:
                WhatToStr := 'kICCSetPref';
            otherwise
                WhatToStr := 'other';
        end; (* case *)
    end; (* WhatToStr *)

    function Main (var params: ComponentParameters; storage: Handle): ComponentResult;
    (* Component entry point.  It's pretty neat IMHO. *)
        var
            proc: ProcPtr;
            s: signedByte;
            res: longint;
    begin
        proc := nil;
(* DebugStr(concat('Enter ', WhatToStr(params.what))); *)
        case params.what of
            (* Component Manager stuff *)
            kComponentVersionSelect:
                Main := internetConfigurationComponentInterfaceVersion;
            kComponentCanDoSelect:
                proc := @RSCCanDo;
            kComponentOpenSelect:
                proc := @RSCOpen;
            kComponentCloseSelect:
                proc := @RSCClose;
            kComponentTargetSelect:
                proc := @RSCTarget;
            kComponentRegisterSelect:
                proc := @RSCRegister;
            kComponentUnregisterSelect:
                proc := @RSCUnregister;
            (* this component type stuff *)
            kICCBegin:
                proc := @RSCBegin;
            kICCGetPref:
                proc := @RSCGetPref;
            kICCSetPref:
                proc := @RSCSetPref;
            otherwise
                ;
        end; (* case *)
        if storage <> nil then begin
            s := HGetState(storage);
            HLock(storage);
        end; (* if *)
        res := delegateThisCallErr;
        if proc <> nil then begin
            res := CallComponentFunctionWithStorage(storage, params, proc);
        end; (* if *)
        if res = delegateThisCallErr then begin
            res := DelegateComponentCall(params, globalsHandle(storage)^^.delegate);
        end; (* if *)
(* DebugStr(concat('Exit ', WhatToStr(params.what), ' with res ', DecStr(res))); *)
        Main := res;
        if storage <> nil then begin
            HSetState(storage, s);
        end; (* if *)
    end; (* Main *)

end. (* ICRandomSignature *)